home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / sharware / debmono / debmono.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-10-03  |  6.4 KB  |  249 lines
  1. {***************************************************
  2. DESCRIPTION
  3. ===========
  4. This component allows a system with a Monochrome
  5. display attached as an alternate monitor to be used
  6. as a 25x70 event display and a 25x10 status area
  7. display.
  8.  
  9. The event messages are upto 70 byte text messages that
  10. are written to the screen and then followed by the
  11. upo-arrow line to mark the most current line.
  12.  
  13. So that multiple pgms can write to the screen
  14. the up-arrow line is searched for to locate the most
  15. current line.  If the up-arrow line is not found the
  16. screen is cleared (it is assumed to be first time).
  17.  
  18. The status messages begin with a 3 byte prefix.
  19.   !nn
  20. where nn is a value between 0 and 24 (always 2 digits).
  21. It specifies the row number where the max 10 byte
  22. msg is written in cols 71 thru 80.
  23.  
  24. INSTALLATION
  25. ============
  26. To install the control, copy the debmono.* files to a directory
  27. on your Delphi library path and select the 
  28.  
  29.                  Options | Install Component 
  30.  
  31. menu item.
  32.  
  33. USAGE
  34. =====
  35.  
  36. (1) As a component.
  37. -------------------
  38.  
  39. The component is added to a form. I suggest renaming
  40. it to something short like DM so that the keystrokes are
  41. reduced.
  42.  
  43. Then statements such as:
  44.  
  45. DM.Text := Format('I=%d N=%.4x',[I,n]);
  46.  
  47. will write a message to the mono screen without
  48. disturbing at all the windows environment (like
  49. changing window focus).
  50.  
  51. The statement
  52.  
  53. DM.Text := Format('!01I=%d',[I]);
  54.  
  55. will replace the status line entry at line 1 of
  56. the status area with a display of the current
  57. value of I.
  58.  
  59. Setting the property NoDisplay to non-zero will cause the
  60. message writing to be completely bypassed.  It can be used
  61. to deactivate debug messages in production mode.  Note that
  62. the overhead of creating the message still exists - only
  63. the displaying of it is bypassed. I have not found a
  64. convenient way in Pascal to turn off code like in C.  Thats
  65. the price for 300,000 lines of code compiled per miniute.
  66.  
  67. (2) As a function.
  68. ------------------
  69.  
  70. Sometimes it is not convenient to create other objects
  71. (such as inside a component) so the MonoText function
  72. can be called directly.  It will have the same effect
  73. as setting a value to DM.Text (except that the test
  74. for NoDisplay) is bypassed. eg.
  75.  
  76. MonoText('This will display');
  77. MonoText(Format('!05Ctr:%.4d',[ctr]));
  78.  
  79. ASIDE
  80. =====
  81. I discovered the Format function which is barely
  82. mentioned in the many Delphi books I have purchased
  83. and which does not exist in Turbo Pascal. The Format
  84. function is a concise way to create messages to
  85. send to the screen. It is similar to printf, so with my
  86. strong backgound in C I felt right at home. 
  87.  
  88. HARDWARE
  89. ========
  90. A monochrome display can be attached to a system for
  91. around $50 ($15 card, $35 used display).  It becomes
  92. a non-obtrusive debugging tool that can be used to
  93. report code paths with variables (event messages)
  94. or to monitor variable values (status messages).
  95.  
  96. Note that under some memory manager systems it is
  97. necessary to use the switch
  98.  DualDisplay=True
  99. in the [386enh] section of the SYSTEM.INI file.
  100.  
  101. COPYRIGHTS
  102. ==========
  103. (c) S.Pritchard at Rexcel Systems Inc. 1995.
  104.  
  105. This small piece of code is a contribution to the
  106. growing collection of free but useful Delphi
  107. components.  It may be freely used in whatever way
  108. you choose provided the original source is
  109. acknowledged.
  110.  
  111. For suggestions, improvements, comments please email
  112. to:
  113.         spritchard@rexcel.com   (preferred)
  114. or
  115.         Compuserve 71221,1607 (Steve Pritchard.)
  116. ****************************************************}
  117.  
  118. unit Debmono;
  119.  
  120. interface
  121.  
  122. uses
  123.   Classes;
  124.  
  125. type
  126.   TDebMono = class(TComponent)
  127.   private
  128.     { Private declarations }
  129.     FNoDisplay: Word; { True if no display }
  130.     procedure SetText(Text: string);
  131.     function GetText: string;
  132.   protected
  133.     { Protected declarations }
  134.   public
  135.     { Public declarations }
  136.   published
  137.     { Published declarations }
  138.     Property Text: string read GetText write SetText;
  139.     Property NoDisplay: Word read FNoDisplay write FNoDisplay;
  140.   end;
  141.  
  142. procedure Register;
  143. procedure MonoAddr;
  144. procedure MonoText(Text: string);
  145.  
  146. implementation
  147.  
  148. procedure MonoAddr; external 'KERNEL' index 181;
  149.  
  150. procedure Register;
  151. begin
  152.   RegisterComponents('srp', [TDebMono]);
  153. end;
  154. {**************************************
  155. Although we do not need this it seems to
  156. avoid a GPF when we try to use the
  157. component.
  158. ***************************************}
  159. function TDebMono.GetText: string;
  160. begin
  161. GetText := '---DebMono V1.00 instantiated---';
  162. end;
  163.  
  164. procedure TDebMono.SetText(Text: string);
  165. begin
  166. if (NoDisplay = 0) then MonoText(Text);
  167. end;
  168.  
  169. {**************************************
  170. Whenever called we copy Text to
  171. the mono display.
  172.  
  173. If the string starts with !nn then we
  174. treat it as a status fld and copy the
  175. remaining string to the status area.
  176. **************************************}
  177. procedure MonoText(Text: string);
  178. var
  179.   pScrn: ^byte;
  180.   pScrnW: ^word;
  181.   pSeg: Word;
  182.   n,n2,nAt,nRow,nStop,nGo,nFlag: word;
  183. begin
  184.  
  185. pSeg := Word(Addr(MonoAddr));
  186. pScrn := Ptr(pSeg,0);
  187.  
  188. {locate the up arrows}
  189. nAt := $FFFF;
  190. for n := 0 to 24 do begin;
  191.     pScrn := Ptr(pSeg,n*160);
  192.     if (pScrn^ = $18) then begin;
  193.        nAt := n;
  194.        break;
  195.     end;
  196. end;
  197.  
  198. {if not found clear the screen}
  199. if (nAt = $FFFF) then begin;
  200.    for n := 0 to 24 do begin;
  201.        for n2 := 0 to 79 do begin;
  202.            pScrnW := Ptr(pSeg,n*160 + n2*2);
  203.            pScrnW^ := $07FA;
  204.        end;
  205.    end;
  206.    nAt := 0;
  207. end;
  208.  
  209. {Set up depending on event | status msg}
  210. nStop := 70; nGo := 1;           {assume event}
  211. nFlag := $7000;
  212. pScrnW := Ptr(pSeg,nAt*160);
  213. if (Text[1] = '!') then begin;   {then status}
  214.    nRow := ((Byte(Text[2]) and $0F) * 10) +
  215.            (Byte(Text[3]) and $0F);
  216.    if (nRow > 24) then nRow := 24;
  217.    nStop := 13; nGo := 4;
  218.    pScrnW := Ptr(pSeg,nRow*160 + 70*2);
  219.    nFlag := $0700;
  220. end;
  221.  
  222. {Copy message to the screen}
  223. for n := nGo to nStop do begin;
  224.    if (n <= length(Text)) then
  225.       n2 := nFlag + Byte(Text[n])
  226.    else
  227.       n2 := nFlag + $20;
  228.    pScrnW^ := n2;
  229.    Longint(pScrnW) := Longint(pScrnW) + 2;
  230. end;
  231.  
  232. {Add the new up arrows - if event msg (not status msg)}
  233. if (nFlag = $7000) then begin;
  234.    Inc(nAt);
  235.    if (nAt > 24) then nAt := 0;
  236.    pScrnW := Ptr(pSeg,nAt*160);
  237.    for n := 1 to 70 do begin;
  238.       if (n <= 20) then
  239.          n2 := $0718
  240.       else
  241.          n2 := $0720;
  242.       pScrnW^ := n2;
  243.       Longint(pScrnW) := Longint(pScrnW) + 2;
  244.    end;
  245. end;
  246. end;
  247. end.
  248.  
  249.